home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 March / EnigmA AMIGA RUN 05 (1996)(G.R. Edizioni)(IT)[!][issue 1996-03][Skylink CD IV].iso / earcd / patches / lhlzxdr5.lha / LhADir.StoneD next >
Text File  |  1995-11-25  |  20KB  |  716 lines
  1. /*
  2.   $VER: LhADir.StoneD 1.0 (18.11.95)
  3.   Copyright © 1995 by Edmund Vermeulen
  4.   This version by Stone-D  (Laga Hale)
  5.   Modified to co-exist with lzx version of same file by Stone-D.
  6.   Placed in the public domain. No restrictions on distribution or usage.
  7.  
  8.   Usage differences with original :
  9.    The original required you to change the lister buttons to link to the
  10.    actual arexx script.  Not so with this one. Change, for example,
  11.    the COPY button from  AREXX DOpus5:Rexx/LhADir.dopus5 {Qp}
  12.    back to the COMMAND COPY.  Do the same with MOVE, and DELETE.
  13.  
  14.   Make sure your lha filetype is configured to call lhadir.stoned, NOT
  15.   lhadir.dopus5  ...  no parameter change, just edit the line to lhadir.stoned
  16.  
  17.   EMail Stone-D at the following address :
  18.  
  19.            stone-d@eldar.demon.co.uk
  20.  
  21.   To make LhADir.Stone-D open it's own listview, refer to line 165
  22.  
  23.   ARexx script for Directory Opus 5 to show the contents of an LhA archive
  24.   in an Opus lister and operate on the files and directories inside the
  25.   archive as if it is a normal directory, whilst allowing simultaneous access
  26.   to similiar scripts...such as the lzxdir.dopus5 one.
  27. */
  28.  
  29. ver='$VER: LhADir.StoneD 1.0'  /* for compiled version */
  30.  
  31. signal on syntax        /* intercept syntax errors */
  32. options results         /* need results */
  33. options failat 21       /* external commands are allowed return code 20 */
  34. numeric digits 10       /* needed for convertdate routine */
  35. lf='0a'x                /* ascii code for linefeed */
  36.  
  37. if ~show('l','rexxsupport.library') then
  38.    call addlib('rexxsupport.library',0,-30)  /* needed for delay() */
  39.  
  40. /* init locale */
  41. ok=show(l,'locale.library')
  42. if ~ok then
  43.    ok=addlib('locale.library',0,-30)
  44. if ok then
  45.    catalog=opencatalog('LhADir.catalog','english',0)
  46.  
  47. parse arg cmd portname . '"' dblclck '"' handle .
  48. upper cmd
  49. if portname~='' then
  50.    address value portname
  51. else
  52.    portname=address()
  53. parse var portname '.' portno  /* port number */
  54.  
  55. if handle='' then do
  56.    lister query source
  57.    if rc>0 then
  58.       call quitit
  59.    parse var result handle .  /* only need first source */
  60.    end
  61.  
  62. lister query handle numselentries
  63. entries=result
  64.  
  65. if dblclck~=='' then do
  66.    entries=1
  67.    if right(dblclck,1)='/' then do
  68.       filetype=1
  69.       selentry=left(dblclck,length(dblclck)-1)
  70.       end
  71.    else do
  72.       filetype=-1
  73.       selentry=dblclck
  74.       end
  75.    end
  76. else
  77.    if entries>0 then
  78.       call getfirstone
  79.  
  80. call checklhadir(handle)
  81.  
  82. topline=''
  83. listlha=0
  84. notmove=cmd~='MOVE'
  85.  
  86. select
  87.    when cmd='GETDIR' then
  88.       call dogetdir
  89.    when cmd='BROWSE' then
  90.       call dogetdir
  91.    when cmd='GETSIZES' then
  92.       call dogetsizes
  93.    when cmd='DELETE' then
  94.       call dodelete
  95.    when cmd='COPY' then
  96.       call docopy
  97.    when cmd='MOVE' then
  98.       call docopy
  99.    when cmd='MAKEDIR' then
  100.       call domakedir
  101.    otherwise
  102.       if lhadir then do
  103.          lister select handle '"'selentry'"' off
  104.          lister refresh handle
  105.          address command 'LhA e -q -x2 -Qo "'patch(lhafile,0)'" T: "'patch(lhasubdir||selentry,1)'"'
  106.          if rc>0 then
  107.             call quitit(getcatstr(11,'Error while extracting from archive.'))
  108.          thisfile='"T:'selentry'"'
  109.          command cmd thisfile
  110.          lister wait handle
  111.          do until rc~=20  /* keep trying until not in use */
  112.             call delay(200)
  113.             address command 'Delete >NIL:' thisfile 'QUIET'
  114.             end
  115.          end
  116.       else
  117.          command cmd
  118.    end
  119.  
  120. call quitit(topline)  /* finished */
  121.  
  122.  
  123. dogetdir:
  124.  
  125.    if ~show('p','LhaDirStoneD-handler'portno) then
  126.       address command 'Run >NIL: <NIL: rx DOpus5:arexx/LhaDirStoneD-handler' portname
  127.    oldlhadir=lhadir
  128.    if entries>0 then
  129.       if filetype>0 then  /* list a new dir */
  130.          if lhadir then
  131.             lhasubdir=lhasubdir||selentry'/'
  132.          else
  133.             winpath=winpath||selentry'/'
  134.       else do  /* list an archive file */
  135.          if pos('|'upper(right(selentry,4)'|'),'|.LHA|.LZH|.RUN|')=0 then
  136.             call quitit(getcatstr(18,'Sorry, LhADir.StoneD can only'lf'list LhA archives.'))
  137.          if lhadir then do
  138.             lister query dest
  139.             if rc>0 then
  140.                call quitit(getcatstr(9,'No destination selected!'))
  141.             parse var result desthandle .
  142.             lister query desthandle path
  143.             destpath=result
  144.             dopus request '"'getcatstr(20,'This is an archive in an archive.'lf||lf'Extract it to'lf"'%s'"lf'and then list it?',destpath)'"' getcatstr(21,'Extract|Cancel')
  145.             if ~rc then
  146.                call quitit
  147.             address command 'LhA e -q -x2 -a -C0 -Qo "'patch(lhafile,0)'" "'destpath'" "'patch(lhasubdir||selentry,1)'"'
  148.             if rc>0 then
  149.                call quitit(getcatstr(11,'Error while extracting from archive.'))
  150.             lister read desthandle '"'destpath'"' force
  151.             lhafile=destpath||selentry
  152.             end
  153.          else
  154.             lhafile=winpath||selentry
  155.  
  156.          lhadir=1
  157.          lhasubdir=''
  158.          listlha=1
  159.          end
  160.  
  161.    lister select handle '"'selentry'"' off
  162.    lister refresh handle
  163.  
  164.    if lhadir then do
  165.       if cmd='BROWSE' then do
  166.          oldhandle=handle
  167. /* The Following makes LhaDir open it's own lister window. Uncomment to make this true */
  168. /*         lister new */
  169. /*         handle=result */
  170.          lister set handle title getcatstr(0,'LhADir listed archive')
  171.          lister set handle source
  172.          address command 'Copy >NIL: T:LhADir.list'oldhandle 'T:LhADir.list'handle
  173.          end
  174.       else do
  175.          if ~oldlhadir then
  176.             lister empty handle  /* use a new cache */
  177.          lister set handle title getcatstr(0,'LhADir listed archive')
  178.          end
  179.       call showlhadir
  180.       end
  181.    else
  182.       if cmd='BROWSE' then
  183.          command scandir new winpath
  184.       else do
  185.          if entries=0 then
  186.             winpath=''
  187.          command scandir winpath
  188.          end
  189.    return
  190.  
  191.  
  192. dodelete:
  193.  
  194.    askdelete=1
  195.    if lhadir then do
  196.       if entries=0 then
  197.          call quitit
  198.       if notmove then do
  199.          lister set handle busy on
  200.          if askdelete then do
  201.             lister query handle numselfiles
  202.             nfiles=result
  203.             lister query handle numseldirs
  204.             ndirs=result
  205.             dopus request '"'getcatstr(5,'Warning: you cannot get back'lf'what you delete! OK to delete:'lf||lf'%s file(s) and'lf'%s drawer(s) (and their contents)?',nfiles,ndirs)'"' getcatstr(6,'Proceed|Cancel')
  206.             if ~rc then
  207.                call quitit
  208.             end
  209.          call getall
  210.          end
  211.       call open('actionfile','T:actionfile'handle,'w')
  212.       do i=1 to entries
  213.          if type.i>0 then
  214.             wild='/#?'
  215.          else
  216.             wild=''
  217.          call writeln('actionfile','"'patch(lhasubdir||name.i,1)||wild'"')
  218.          lister remove handle '"'name.i'"'
  219.          end
  220.       call close('actionfile')
  221.       lister set handle progress '-1' getcatstr(7,'Deleting from archive...')
  222.       address command 'LhA d -q -Qp -Qo "'patch(lhafile,0)'" @T:actionfile'handle
  223.       if rc>0 then do
  224.          topline=getcatstr(8,'Error while deleting from archive.')
  225.          listlha=1
  226.          call showlhadir
  227.          end
  228.       else
  229.          lister refresh handle
  230.       address command 'Delete >NIL: T:actionfile'handle 'QUIET'
  231.       address command 'Delete >NIL: T:LhADir.list'handle 'QUIET'  /* archive has changed */
  232.       lister set handle busy off
  233.       end
  234.    else do
  235.       command delete
  236.       lister wait handle
  237.       end
  238.    return
  239.  
  240.  
  241. docopy:
  242.  
  243.    if entries=0 then
  244.       call quitit
  245.    problem=0
  246.    src=winpath
  247.    s_lhadir=lhadir
  248.    s_lhafile=lhafile
  249.    s_lhasubdir=lhasubdir
  250.    lister query dest
  251.    if rc>0&lhadir then
  252.       call quitit(getcatstr(9,'No destination selected!'))
  253.    parse var result desthandle .  /* only need first destination */
  254.    call checklhadir(desthandle)
  255.  
  256.    if s_lhadir then do
  257.       lister set handle busy on
  258.       lister set desthandle busy on
  259.       if lhadir then
  260.          winpath='T:LhADir'handle'/'lhasubdir
  261.       call getall
  262.       call lhaextract
  263.       if lhadir then do
  264.          src=winpath
  265.          call lhaadd
  266.          end
  267.       else
  268.          if problem then do
  269.             lister set desthandle busy off
  270.             lister read desthandle '"'destpath'"' force
  271.             end
  272.          else do
  273.             do i=1 to entries
  274.                lister query handle entry '"'name.i'"' stem fileinfo.
  275.                if fileinfo.type>0 then
  276.                   fileinfo.size=0
  277.                lister add desthandle '"'name.i'"' fileinfo.size fileinfo.type fileinfo.date fileinfo.protstring fileinfo.comment
  278.                end
  279.             lister refresh desthandle
  280.             end
  281.       end
  282.    else
  283.       if lhadir then do
  284.          lister set handle busy on
  285.          if ~notmove then do
  286.             cuthere=lastpos('/',lhafile)
  287.             if cuthere=0 then
  288.                cuthere=pos(':',lhafile)
  289.             name=substr(lhafile,cuthere+1)
  290.             if left(lhafile,length(src))==src then do
  291.                name=substr(lhafile,length(src)+1)
  292.                parse var name name '/'
  293.                lister query handle entry '"'name'"' stem fileinfo.
  294.                if fileinfo.selected then
  295.                   call quitit(getcatstr(19,'You can''t move an archive into itself!'))
  296.                end
  297.             end
  298.          lister set desthandle busy on
  299.          call getall
  300.          call lhaadd
  301.          end
  302.       else do /* normal copy or move */
  303.          if notmove then
  304.             command copy
  305.          else
  306.             command move
  307.          lister wait handle
  308.          end
  309.  
  310.    lister set handle busy off
  311.    lister set desthandle busy off
  312.    if (s_lhadir|lhadir)&~notmove&~problem then do
  313.       lhadir=s_lhadir
  314.       lhafile=s_lhafile
  315.       lhasubdir=s_lhasubdir
  316.       lister query handle abort
  317.       if result then
  318.          call quitit(getcatstr(3,'Aborted...'))
  319.       lister set handle busy off
  320.       lister wait handle
  321.       call dodelete
  322.       end
  323.    return
  324.  
  325.  
  326. dogetsizes:
  327.  
  328.    if lhadir then do
  329.       lister set handle busy on
  330.       lister set handle progress '-1' getcatstr(14,'Scanning directories...')
  331.       lister query handle numseldirs
  332.       ndirs=result
  333.       lister query handle seldirs stem dname.
  334.       n=1
  335.       do i=0 to dname.count-1
  336.          dirname.n=dname.i
  337.          lister query handle entry '"'dirname.n'"' stem fileinfo.
  338.          if fileinfo.size=0 then
  339.             n=n+1
  340.          end
  341.       dirsize.=0
  342.       dirsecs.=0
  343.       ndirs=n-1
  344.       call readlist(0)
  345.       lister set handle busy off
  346.       end
  347.    else
  348.       command getsizes
  349.    return
  350.  
  351.  
  352. domakedir:
  353.  
  354.    lister set handle busy on
  355.    dopus getstring '"'getcatstr(15,'Enter directory name or archive name.lha')'" 31 ""' getcatstr(16,'OK|Cancel')
  356.    dirtomake=result
  357.    if dirtomake==''|dirtomake='RESULT' then
  358.       call quitit
  359.    now=date('i')*86400+time('s')
  360.    if lhadir then do  /* create empty dir in archive */
  361.       call createdirs(dirtomake'/')
  362.       address command 'LhA a -q -e -r -Qo "'patch(lhafile,0)'" T:LhADir'handle'/' '"'patch(lhasubdir||dirtomake,1)'"'
  363.       if rc>0 then
  364.          topline=getcatstr(13,'Error while adding to archive.')
  365.       else do
  366.          lister add handle '"'dirtomake'" -1 1' now '----rwed'
  367.          lister refresh handle
  368.          end
  369.       address command 'Delete >NIL: T:LhADir'handle 'ALL QUIET'
  370.       address command 'Delete >NIL: T:LhADir.list'handle 'QUIET'
  371.       end
  372.    else
  373.       if upper(right(dirtomake,4))=='.LHA' then  /* create new archive */
  374.          if open('emptyarchive',winpath||dirtomake,'w') then do
  375.             call writech('emptyarchive','0'x)
  376.             call close('emptyarchive')
  377.             command protect 'NAME "'winpath||dirtomake'" CLEAR e'
  378.             lister add handle '"'dirtomake'" 1 -1' now '----rw-d'
  379.             lister refresh handle
  380.             end
  381.          else
  382.             topline=getcatstr(17,'Error creating archive.')
  383.       else do /* normal makedir */
  384.          lister set handle busy off
  385.          command makedir 'NOICON NAME "'dirtomake'"'
  386.          end
  387.     return
  388.  
  389.  
  390. showlhadir:
  391.  
  392.    lister clear handle
  393.    lister set handle busy on
  394.    lister set handle progress '-1' getcatstr(1,'Listing archive...')
  395.    lister set handle handler 'LhaDirStoneD-handler'portno
  396.    lister set handle path lhafile'/'lhasubdir
  397.    lister refresh handle full
  398.    now=date('i')*86400+time('s')
  399.    ndirs=0
  400.    call readlist(1)
  401.    return
  402.  
  403.  
  404. readlist:
  405.  
  406.    arg show  /* showdir or getsizes? */
  407.    if ~exists(lhafile) then
  408.       call quitit(getcatstr(22,'Error, archive not found.'))
  409.    if listlha|~exists('T:LhADir.list'handle) then
  410.       call lhalist
  411.    call open('tempfile','T:LhADir.list'handle,'r')
  412.    do 3
  413.       call readln('tempfile')  /* waste the first 3 lines */
  414.       end
  415.  
  416.    compstr=upper(lhasubdir)
  417.    complen=length(compstr)
  418.    nextline=readln('tempfile')
  419.  
  420.    do forever
  421.       name=nextline
  422.       infoline=readln('tempfile')
  423.       do while pos('% ',infoline)<22
  424.          name=infoline
  425.          infoline=readln('tempfile')
  426.          end
  427.       if name=='-------- ------- ----- --------- --------' then
  428.          leave
  429.       nextline=readln('tempfile')
  430.       if left(nextline,1)==':' then do
  431.          parse var nextline 3 comment
  432.          nextline=readln('tempfile')
  433.          end
  434.       else
  435.          comment=''
  436.  
  437.       if upper(left(name,complen))==compstr then do
  438.          name=substr(name,complen+1)
  439.          if name~==''&pos('"',name)=0 then do
  440.             if pos('/',name)>0 then do  /* it's a dir */
  441.                parse var name dirname '/'
  442.                olddir=0
  443.                i=ndirs+1
  444.                do while i>1&~olddir
  445.                   i=i-1
  446.                   olddir=upper(dirname)==upper(dirname.i)
  447.                   end
  448.                if olddir&~show then do
  449.                   call convertdate
  450.                   dirsize.i=dirsize.i+size
  451.                   if seconds>dirsecs.i then
  452.                      dirsecs.i=seconds
  453.                   end
  454.                if show&~olddir then do  /* a new dir */
  455.                   ndirs=ndirs+1
  456.                   dirname.ndirs=dirname
  457.                   lister add handle '"'dirname'" -1 1' now '----rwed'
  458.                   end
  459.                end
  460.             else  /* it's a file */
  461.                if show then do
  462.                   call convertdate
  463.                   lister add handle '"'name'"' size '-1' seconds atts comment
  464.                   end
  465.             end
  466.          end
  467.       end
  468.    call close('tempfile')
  469.    if ~show then
  470.       do i=1 to ndirs
  471.          lister add handle '"'dirname.i'"' dirsize.i '1' dirsecs.i '----rwed'
  472.          lister select handle '"'dirname.i'"' on
  473.          end
  474.    lister refresh handle full
  475.    return
  476.  
  477.  
  478. checklhadir:
  479.  
  480.    arg checkhandle
  481.    lister query checkhandle path
  482.    winpath=result
  483.    test=upper(winpath)
  484.    cuthere=pos('.LHA/',test)
  485.    if cuthere=0 then
  486.       cuthere=pos('.LZH/',test)
  487.    if cuthere=0 then
  488.       cuthere=pos('.RUN/',test)
  489.    lhadir=cuthere>0
  490.    if lhadir then do
  491.       lhafile=left(winpath,cuthere+3)
  492.       lhasubdir=substr(winpath,cuthere+5)
  493.       end
  494.    return
  495.  
  496.  
  497. lhaextract:
  498.  
  499.    lister query handle numdirs
  500.    anydirs=result>0
  501.    mustmove=anydirs&s_lhasubdir~==''
  502.    if mustmove then
  503.       destpath=winpath'LhADir'handle'/'
  504.    else
  505.       destpath=winpath
  506.  
  507.    call open('actionfile','T:actionfile'handle,'w')
  508.    do i=1 to entries
  509.       if type.i>0 then
  510.          wild='/#?'
  511.       else
  512.          wild=''
  513.       call writeln('actionfile','"'patch(s_lhasubdir||name.i,1)||wild'"')
  514.       end
  515.    call close('actionfile')
  516.  
  517.    if anydirs then
  518.       lhacmd='x'
  519.    else
  520.       lhacmd='e -x2'
  521.    lister set handle progress '-1' getcatstr(10,'Extracting from archive...')
  522.    address command 'LhA' lhacmd '-q -a -C0 -Qo "'patch(s_lhafile,0)'" "'destpath'" @T:actionfile'handle
  523.    problem=rc>0
  524.    if problem then
  525.       topline=getcatstr(11,'Error while extracting from archive.')
  526.    else
  527.       if notmove then do
  528.          do i=1 to entries
  529.             lister select handle '"'name.i'"' off
  530.             end
  531.          lister refresh handle
  532.          end
  533.  
  534.    if mustmove then do
  535.       address command 'Rename >NIL: "'winpath'LhADir'handle'/'s_lhasubdir'#?" "'winpath'" QUIET'
  536.       address command 'Delete >NIL: "'winpath'LhADir'handle'" ALL QUIET'
  537.       end
  538.    address command 'Delete >NIL: T:actionfile'handle 'QUIET'
  539.    return
  540.  
  541.  
  542. lhaadd:
  543.  
  544.    mustcopy=upper(right(src,length(lhasubdir)))~==upper(lhasubdir)
  545.    if mustcopy then do  /* all files must be copied to T: before they can be added */
  546.       homedir='T:LhADir'handle'/'
  547.       call createdirs
  548.       end
  549.    else
  550.       homedir=left(src,length(src)-length(lhasubdir))
  551.    call open('actionfile','T:actionfile'handle,'w')
  552.    call writeln('actionfile','"'patch(homedir,0)'"')
  553.  
  554.    if s_lhadir then
  555.       call writeln('actionfile','#?')
  556.    else do
  557.       do i=1 to entries
  558.          call writeln('actionfile','"'patch(lhasubdir||name.i,0)'"')
  559.          if mustcopy then
  560.             address command 'Copy "'src||name.i'" "T:LhADir'handle'/'lhasubdir'"'
  561.          end
  562.       end
  563.    call close('actionfile')
  564.  
  565.    if pos('.LZH/',test)>0 then
  566.       method='-0'
  567.    else
  568.       method=''
  569.    lister set desthandle progress '-1' getcatstr(12,'Adding to archive...')
  570.    address command 'LhA r' method '-q -e -r -Qo "'patch(lhafile,0)'" @T:actionfile'handle
  571.    problem=rc>0
  572.    if problem then
  573.       topline=getcatstr(13,'Error while adding to archive.')
  574.    else
  575.       if notmove then do
  576.          do i=1 to entries
  577.             lister select handle '"'name.i'"' off
  578.             end
  579.          lister refresh handle
  580.          end
  581.    address command 'Delete >NIL: T:actionfile'handle 'QUIET'
  582.    if mustcopy|s_lhadir then
  583.       address command 'Delete >NIL: T:LhADir'handle 'ALL QUIET'
  584.  
  585.    call swapactive
  586.    listlha=1
  587.    call showlhadir
  588.    call swapactive
  589.    return
  590.  
  591.  
  592. lhalist:
  593.  
  594.    address command 'LhA >T:LhADir.list'handle 'vv -N -Qw -Qo "'lhafile'"'
  595.    if rc>0 then
  596.       call quitit(getcatstr(2,'Error while listing archive.'))
  597.    return
  598.  
  599.  
  600. swapactive:
  601.  
  602.    swaphandle=handle
  603.    handle=desthandle
  604.    desthandle=swaphandle
  605.    return
  606.  
  607.  
  608. createdirs:
  609.  
  610.    parse arg subdir
  611.    dirstocreate='T:LhADir'handle'/'lhasubdir||subdir
  612.    here=0
  613.    mdstring=''
  614.    do until here=0
  615.       here=pos('/',dirstocreate,here+1)
  616.       if here>0 then
  617.          mdstring=mdstring '"'left(dirstocreate,here-1)'"'
  618.       end
  619.    address command 'MakeDir >NIL:' mdstring
  620.    return
  621.  
  622.  
  623. getall:
  624.  
  625.    lister query handle numseldirs
  626.    ndirs=result
  627.    lister query handle seldirs
  628.    do n=1 to ndirs
  629.       parse var result '"' name.n '"' result
  630.       type.n=1
  631.       end
  632.    lister query handle numselfiles
  633.    nfiles=result
  634.    lister query handle selfiles
  635.    do n=ndirs+1 to ndirs+nfiles
  636.       parse var result '"' name.n '"' result
  637.       type.n=-1
  638.       end
  639.    entries=ndirs+nfiles
  640.    return
  641.  
  642.  
  643. convertdate:  /* convert a file's datestamp to seconds past 01-Jan-78 */
  644.  
  645.    parse var infoline size . '% ' day '-' month '-' year ' ' hours ':' minutes ':' seconds atts .
  646.    minus=day='00'
  647.    if minus then
  648.       day='01'
  649.    century=19+(year<78)
  650.    month=pos(month,'  JanFebMarAprMayJunJulAugSepOctNovDec')/3
  651.    month=right(month,2,'0')
  652.    if month='00' then
  653.       month='01'
  654.    seconds=seconds+minutes*60+hours*3600+(date('i',century||year||month||day,'s')-minus)*86400
  655.    return
  656.  
  657.  
  658. getfirstone:
  659.  
  660.    lister query handle firstsel
  661.    selentry=result
  662.    lister query handle entry selentry stem fileinfo.
  663.    selentry=fileinfo.name
  664.    filetype=fileinfo.type
  665.    return
  666.  
  667.  
  668. patch:  /* patch filenames containing strange characters */
  669.  
  670.    parse arg patched,apostrophe
  671.    verstr='*#?|%()[]~'
  672.    if apostrophe then
  673.       verstr=verstr"'"
  674.    pos=1
  675.    do until here=0
  676.       here=verify(substr(patched,pos),verstr,'m')
  677.       if here>0 then do
  678.          pos=pos+here+1
  679.          patched=insert("'",patched,pos-3)
  680.          end
  681.       end
  682.    if left(patched,1)='@' then
  683.       patched='*'patched
  684.    return patched
  685.  
  686.  
  687. getcatstr:
  688.  
  689.    parse arg msgno,msgstring,insert.1,insert.2
  690.    if catalog~=0 then
  691.       msgstring=getcatalogstr(catalog,msgno,msgstring)
  692.    i=0
  693.    do while pos('%s',msgstring)>0
  694.       parse var msgstring fore '%s' aft
  695.       i=i+1
  696.       msgstring=fore||insert.i||aft
  697.       end
  698.    return msgstring
  699.  
  700.  
  701. syntax:
  702.  
  703.    call quitit('Syntax Error' rc',' errortext(rc) 'in line' sigl'.')
  704.  
  705.  
  706. quitit:
  707.  
  708.    parse arg topline
  709.    lister clear handle progress
  710.    lister set handle busy off
  711.    if catalog~=0 then
  712.       call closecatalog(catalog)
  713.    if topline~=='' then
  714.       dopus request '"'topline'"' getcatstr(4,'OK')
  715.    exit
  716.